home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zk.d64 / src.environment < prev    next >
Text File  |  2007-03-01  |  4KB  |  224 lines
  1. ;  >S:SRC.ENVIRONMENT
  2. ;PUT "SRC.ENVIRONMENT"
  3. ;
  4. ;--------------------------------;
  5. ; SRC.ENVIRONMENT - A COMAL PKG  ;
  6. ;                                ;
  7. ; EXTENDING COMAL WITH           ;
  8. ;     PROC STORE(X$)             ;
  9. ;     PROC ACCEPT(REF X$)        ;
  10. ;     FUNC GLOBAL                ;
  11. ;     PROC ZEROGLOBAL            ;
  12. ;                                ;
  13. ; BY DICK KLINGENS               ;
  14. ; DUTCH COMAL USERS GROUP        ;
  15. ; JAN87                          ;
  16. ;--------------------------------;
  17. ;
  18. ORG    = $8009
  19. ;
  20. GLOBFL = $0055
  21. ENVIR  = $C080
  22. ;
  23. FALSE  = 0
  24. TRUE   = 1
  25. DEFPAG = $46
  26. FUNC   = $E3
  27. PROC   = $70
  28. ENDFNC = $7E
  29. ENDPRC = $7E
  30. REAL   = $00
  31. VALUE  = $72
  32. REF    = $75
  33. STR    = $02
  34. ;
  35. COPYDN = $C8A2
  36. FNDPAR = $C896
  37. PSHINT = $C9CE
  38. RUNERR = $C9FB
  39. ;
  40. COPY1  = $45
  41. COPY2  = COPY1+2
  42. COPY3  = COPY2+2
  43. ;
  44. ;--------------------------------;
  45. ; PACKAGE DEFINITION             ;
  46. ;--------------------------------;
  47. ;
  48. *      = ORG
  49. ;
  50.  .BYT DEFPAG
  51.  .WOR END
  52.  .WOR SENSE
  53. ;
  54.  .BYT 11,'ENVIRONMENT'
  55.  .WOR TABLE
  56.  .WOR SENSE
  57. ;
  58.  .BYT 0
  59. ;
  60. TABLE
  61. ;--------------------------------;
  62. ; NAME TABLE                     ;
  63. ;--------------------------------;
  64. ;
  65. .BYT 5,'STORE'
  66. .WOR HSTOR
  67. .BYT 6,'ACCEPT'
  68. .WOR HACCE
  69. .BYT 6,'GLOBAL'
  70. .WOR HGLOB
  71. .BYT 10,'ZEROGLOBAL'
  72. .WOR HZERO
  73. ;
  74. .BYT 0
  75. ;
  76. ;--------------------------------;
  77. ; HEADERS                        ;
  78. ;--------------------------------;
  79. ;
  80. HSTOR
  81.  .BYT PROC
  82.  .WOR CSTOR
  83.  .BYT 1
  84.  .BYT VALUE+STR
  85.  .BYT ENDPRC
  86. ;
  87. HACCE
  88.  .BYT PROC
  89.  .WOR CACCE
  90.  .BYT 1
  91.  .BYT REF+STR
  92.  .BYT ENDPRC
  93. ;
  94. HGLOB
  95.  .BYT FUNC+REAL
  96.  .WOR CGLOB
  97.  .BYT 0
  98.  .BYT ENDFNC
  99. ;
  100. HZERO
  101.  .BYT PROC
  102.  .WOR CZERO
  103.  .BYT 0
  104.  .BYT ENDPRC
  105. ;
  106. ;--------------------------------;
  107. ; CODE                           ;
  108. ;--------------------------------;
  109. ;
  110. SENSE RTS
  111. ;
  112. ; --------------- PROC STORE(STR$)
  113. ;
  114. CSTOR LDA #1
  115.       JSR FNDPAR
  116.       LDY #2
  117.       LDA (COPY1),Y   ;A=LEN
  118.       BNE ARGERR
  119.       INY
  120.       LDA (COPY1),Y
  121.       CMP #127        ;LEN<=126
  122.       BCS ARGERR
  123. ;
  124.       LDA #TRUE
  125.       STA GLOBFL
  126. ;
  127.       LDA COPY1       ;COPY
  128.       CLC             ;FROM
  129.       ADC #<2         ;LO/HI
  130.       STA COPY1
  131.       LDA COPY1+1
  132.       ADC #>2
  133.       STA COPY1+1
  134. ;
  135.       LDA #<ENVIR     ;COPY
  136.       LDY #>ENVIR     ;TO
  137.       STA COPY2       ;LO/HI
  138.       STY COPY2+1
  139. ;
  140.       LDY #1          ;LENGTH
  141.       LDA (COPY1),Y   ;HI/LO
  142.       CLC
  143.       ADC #<2
  144.       STA COPY3+1
  145.       DEY
  146.       LDA (COPY1),Y
  147.       ADC #>2
  148.       STA COPY3
  149. ;
  150.       JMP COPYDN
  151. ;
  152. ; ------------------ ENDPROC STORE
  153. ;
  154. ; ------------------- FUNC ERRTEXT
  155. ;
  156. ARGERR LDX #1
  157.        .BYT $2C
  158. NOTVAR LDX #62
  159.        JMP RUNERR
  160. ;
  161. ; ---------------- ENDFUNC ERRTEXT
  162. ;
  163. ; ---------- PROC ACCEPT(REF STR$)
  164. ;
  165. CACCE LDA GLOBFL
  166.       AND #1
  167.       BEQ NOTVAR
  168.       LDA #1
  169.       JSR FNDPAR
  170.       LDY #1
  171.       LDA (COPY1),Y
  172.       SEC
  173.       SBC ENVIR+1
  174.       DEY
  175.       LDA (COPY1),Y
  176.       SBC ENVIR
  177.       BCC ARGERR
  178. ;
  179.       LDA COPY1       ;COPY
  180.       CLC             ;TO
  181.       ADC #<2
  182.       STA COPY2
  183.       LDA COPY1+1
  184.       ADC #>2
  185.       STA COPY2+1
  186. ;
  187.       LDA #<ENVIR     ;COPY
  188.       LDY #>ENVIR     ;FROM
  189.       STA COPY1
  190.       STY COPY1+1
  191. ;
  192.       LDA ENVIR+1     ;LENGTH
  193.       CLC
  194.       ADC #<2
  195.       STA COPY3+1
  196.       LDA ENVIR
  197.       ADC #>2
  198.       STA COPY3
  199. ;
  200.      JMP COPYDN
  201. ;
  202. ; ----------------- ENDPROC ACCEPT
  203. ;
  204. ; -------------------- FUNC GLOBAL
  205. ;
  206. CGLOB LDA GLOBFL
  207.       AND #1
  208.       TAX
  209.       LDA #0
  210.       JMP PSHINT
  211. ;
  212. ; ----------------- ENDFUNC GLOBAL
  213. ;
  214. ; ---------------- PROC ZEROGLOBAL
  215. ;
  216. CZERO LDA #FALSE
  217.       STA GLOBFL
  218.       RTS
  219. ;
  220. ; ------------- ENDPROC ZEROGLOBAL
  221. ;
  222. END   .END
  223. ;
  224.